home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / other / gui4cli / tools / palette.gc < prev    next >
Text File  |  1999-05-14  |  7KB  |  248 lines
  1. G4C
  2.  
  3. ; Palette.gc by D.Keletsekis & J.Collett
  4. ; ---------------------------------------------------------------
  5. ; A full palette gui with many capabilities
  6. ; Press CONTROL-J to make it jump screens
  7. ; ---------------------------------------------------------------
  8.  
  9. winbig -1 -1 235 120 'Palette'
  10. wintype 11110001
  11. resinfo 8 680 230  ; info for auto-resize
  12.  
  13. box 0 0 0 0 out button
  14.  
  15. ; ---------------------------------------------------------------
  16. ;    system events
  17. ; ---------------------------------------------------------------
  18.  
  19. xonload
  20.     guiopen palette.gc
  21.  
  22. xonopen
  23.     info palette palette.gc/5    ; get info on *our* platte
  24.     type = 'update'            ; set the subroutine type
  25.     gosub palette.gc update        ; Subroutine
  26.  
  27. xonRMB        
  28.     ; on rmb we update to the color under mouse position
  29.     update palette.gc 5 $$mouse.color
  30.     ; and update since we did not click on the palette
  31.     gosub palette.gc update
  32.  
  33. xonclose
  34.     guiquit palette.gc
  35.  
  36. ; ---------------------------------------------------------------
  37. ;    palette & sliders
  38. ; ---------------------------------------------------------------
  39.  
  40. xPalette 10 5 225 30
  41.     gadid 5
  42.     gadhelp 'Click on a color, (or click RMB anywhere else)'
  43.     gosub palette.gc $type
  44.  
  45. xHSlider 40 40 160 12 R red 0 15 0 %2ld
  46.     gadhelp "Adjust RED intensity"
  47.     setcolor palette.gc $$color.num $red $green $blue
  48.     gadid 1
  49.  
  50. xHSlider 40 52 160 12 G green 0 15 0 %2ld
  51.     gadhelp "Adjust GREEN intensity"
  52.     setcolor palette.gc $$color.num $red $green $blue
  53.     gadid 2
  54.  
  55. xHSlider 40 64 160 12 B blue 0 15 0 %2ld
  56.     gadhelp "Adjust BLUE intensity"
  57.     setcolor palette.gc $$color.num $red $green $blue
  58.     gadid 3
  59.  
  60.  
  61. ; ---------------------------------------------------------------
  62. ;    routine to update sliders & get variables
  63. ; ---------------------------------------------------------------
  64.  
  65. xRoutine update
  66.     ; get the current values from internal variables
  67.     red   = $$color.r
  68.     green = $$color.g
  69.     blue  = $$color.b
  70.     num   = $$color.num
  71.     total = $$color.total
  72.  
  73.     oldred   = $red        ; store old values for undo
  74.     oldgreen = $green
  75.     oldblue  = $blue
  76.  
  77.     update palette.gc 1 $red    ; Update sliders
  78.     update palette.gc 2 $green
  79.     update palette.gc 3 $blue
  80.  
  81.     setwintitle palette.gc 'Palette color $num of $total'
  82.  
  83.  
  84. ; ---------------------------------------------------------------
  85. ;    Undo button
  86. ; ---------------------------------------------------------------
  87.  
  88. xbutton 10 85 70 14 Undo     ; undo last changes
  89.     setcolor palette.gc $$color.num $oldred $oldgreen $oldblue
  90.     gosub palette.gc update
  91.  
  92.  
  93. ; ---------------------------------------------------------------
  94. ;    Load a previously saved palette 
  95. ;    (i.e. a normal GUI with a list of setcolor commands)
  96. ; ---------------------------------------------------------------
  97.  
  98. xbutton  80 85 70 14 Load..
  99.     gadhelp "Load a previously saved gui, which sets the palette."
  100.     filename = ''
  101.     ReqFile -1 -1 300 -40 'Load Palette gui:' LOAD filename 'GUIs:tools/palette'
  102.     if $filename > ' '
  103.        if $filename H= "G4C"
  104.           guiload $filename palette.gc    ; pass our gui name as argument
  105.           update palette.gc 5 1        ; go back to color No 1
  106.           info palette palette.gc/5        ; get info on palette
  107.           gosub palette.gc update        ; redraw the sliders etc
  108.        else
  109.           ezreq 'Please choose a Gui4Cli script pallete' OK ''
  110.        endif
  111.     endif
  112.  
  113.  
  114. ; ---------------------------------------------------------------
  115. ;    Save a palette
  116. ;    make a loop and write a gui to set all colors
  117. ; ---------------------------------------------------------------
  118.  
  119. xbutton  150 85 70 14 Save..
  120.     gadhelp "Save the current palette as a Gui."
  121.     filename = ''
  122.     ReqFile -1 -1 300 -40 'Save Palette as:' SAVE filename 'Guis:tools/palette'
  123.     if $filename = ''
  124.        stop
  125.     endif
  126.     guiwindow palette.gc wait
  127.     setwintitle palette.gc 'Saving Palette...'
  128.     info palette palette.gc/5       ; make sure we're talcking about *our* palette
  129.     .palette = 'G4C\n\n;Palette\n\nxOnLoad gui\n'
  130.     count = 0
  131.     while $count < $total
  132.         update palette.gc 5 $count  ; choose each colors in sequence
  133.         append env:.palette 'setcolor \$gui $count $$color.r $$color.g $$color.b\n'
  134.         ++count
  135.     endwhile
  136.     extract filename file guiname
  137.     append env:.palette 'guiquit $guiname\n'
  138.     copy env:.palette $filename
  139.     delete env:.palette
  140.     guiwindow palette.gc resume
  141.     update palette.gc 5 1
  142.     info palette palette.gc/5
  143.     gosub palette.gc update
  144.  
  145.  
  146. ; ---------------------------------------------------------------
  147. ;     Copy, Exchange, Spread buttons
  148. ; ---------------------------------------------------------------
  149.  
  150. xbutton  10 100 70 14 Copy
  151.     gosub palette.gc fixvalues
  152.     type = 'copy'
  153.  
  154. xbutton  80 100 70 14 Exchange
  155.     gosub palette.gc fixvalues
  156.     type = 'exchange'
  157.  
  158. xbutton  150 100 70 14 Spread
  159.     gosub palette.gc fixvalues
  160.     type = 'spread'
  161.  
  162. ; store the current values in undo since we'll need them
  163. xRoutine fixvalues
  164.     oldred   = $red
  165.     oldgreen = $green
  166.     oldblue  = $blue
  167.  
  168. ; ---------------------------------------------------------------
  169. ;    routine to copy values
  170. ; ---------------------------------------------------------------
  171.  
  172. xRoutine copy
  173.     ;Set new colour to old values
  174.     setcolor palette.gc $$color.num $oldred $oldgreen $oldblue
  175.     type = 'update'        ; Reset routine flag
  176.     setwintitle palette.gc 'Copied color $num to $$color.num'
  177.     num = $$color.num
  178.     update palette.gc 5 $num
  179.     gosub palette.gc update
  180.  
  181.  
  182. ; ---------------------------------------------------------------
  183. ;    routine to exchange values
  184. ; ---------------------------------------------------------------
  185.  
  186. xRoutine exchange
  187.     pal.on = $num       ; Store existing colour number
  188.     red = $$color.r     ; get new values  
  189.     green = $$color.g
  190.     blue = $$color.b
  191.     num = $$color.num
  192.     ;Set each colour to other values
  193.     setcolor palette.gc $num  $oldred $oldgreen $oldblue
  194.     setcolor palette.gc $pal.on  $red $green $blue
  195.     type = 'update'             ; Reset routine flag
  196.     ; Update window title
  197.     setwintitle palette.gc 'Exchanged colors $pal.on and $num'
  198.     update palette.gc 5 $num
  199.     gosub palette.gc update
  200.  
  201.  
  202. ; ---------------------------------------------------------------
  203. ;    Routine to do the spreading.
  204. ; ---------------------------------------------------------------
  205.  
  206. xROUTINE spread 
  207.     ; use local variables..
  208.     local col2/r2/g2/b2/rstep/gstep/bstep/sign/colnum/r/g/b
  209.     ; get the 2nd color values
  210.     col2 = $$color.num
  211.     r2   = $$color.r 
  212.     g2   = $$color.g
  213.     b2   = $$color.b
  214.  
  215.     ; if there is no spread, return
  216.     if $(abs($num - $col2)) <= 1
  217.        return
  218.     endif
  219.  
  220.     ; which direction are we going
  221.     sign = 1
  222.     if $num > $col2
  223.        sign = -1
  224.     endif
  225.  
  226.     ; how many colors are we spreading ?
  227.     colnum = $(abs($col2 - $num) - 1)
  228.  
  229.     ; work out the change step for each color
  230.     rstep  = $(($r2 - $oldred)   / $colnum) 
  231.     gstep  = $(($g2 - $oldgreen) / $colnum) 
  232.     bstep  = $(($b2 - $oldblue)  / $colnum) 
  233.  
  234.     ; set all colors
  235.     count = 0
  236.     while $count < $colnum
  237.        ++count
  238.        ; use == so we get integers (should add trunc(x) function)
  239.        r == $($oldred   + ($count * $rstep)) * 1
  240.        g == $($oldgreen + ($count * $gstep)) * 1
  241.        b == $($oldblue  + ($count * $bstep)) * 1
  242.        setcolor palette.gc $($num + ($count * $sign)) $r $g $b
  243.     endwhile
  244.  
  245.     type = 'update'             ; Reset routine flag
  246.     gosub palette.gc update
  247.  
  248.